home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / oop.swg / 0023_Dynamic OPP Box Object.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-17  |  4KB  |  169 lines
  1. program Dynamic_Object_Demo;
  2.  
  3.  { DYN-DEMO.PAS }
  4.  
  5. uses Crt, Dos;
  6.  
  7. type
  8.    ScrPtr = ^SaveScreen;
  9.    BoxPtr = ^ReportBox;
  10.    SaveScreen = array[1..80,1..25] of word;
  11.    ReportBox = object
  12.       SavPtr: ScrPtr;  FColor, BColor: byte;
  13.       WPosX, WPosY, WSizeX, WSizeY: integer;
  14.       constructor Init( PtX, PtY, Width, Height,
  15.                          C1, C2 : integer );
  16.       destructor  Done;
  17.       procedure   Draw;
  18.       procedure   Erase;
  19.    end;
  20.  
  21. {==========================================}
  22. { implementation for object type ReportBox }
  23. {==========================================}
  24.  
  25. constructor ReportBox.Init;
  26. var
  27.    i, j: integer;
  28.    Regs: Registers;
  29. begin
  30.    WPosX  := PtX;
  31.    WPosY  := PtY;
  32.    WSizeX := Width;
  33.    WSizeY := Height;
  34.    FColor := C1;
  35.    BColor := C2;
  36.    New( SavPtr ); { allocate memory for array }
  37.    window( WPosX, WPosY, WPosX+WSizeX-1,
  38.                          WPosY+WSizeY-1 );
  39.  
  40.   {read character and attribute on video page 0}
  41.  
  42.    for i := 1 to WSizeX do
  43.       for j := 1 to WSizeY do
  44.       begin
  45.          gotoxy(i,j);
  46.          Regs.AH := 08;
  47.          Regs.BH := 00;
  48.          intr( $10, Regs );
  49.          SavPtr^[i,j] := Regs.AX;
  50.       end;
  51.    Draw;
  52. end;
  53.  
  54. destructor ReportBox.Done;
  55. begin
  56.    Erase;
  57.    Dispose( SavPtr );
  58. end;
  59.  
  60. procedure ReportBox.Erase;
  61. var
  62.    i, j : integer;
  63.    Regs : Registers;
  64. begin
  65.    window( WPosX, WPosY,
  66.            WPosX+WSizeX-1, WPosY+WSizeY-1 );
  67.    ClrScr;   { inner window }
  68.  
  69. { Write character and attr on video page 0 }
  70.  
  71. { AL stores the character value }
  72. { BL stores the attribute value }
  73. { CL stores the repititions value (1) }
  74.  
  75.    for i := 1 to WSizeX do
  76.       for j := 1 to WSizeY do
  77.       begin
  78.          gotoxy(i,j);
  79.          Regs.AH := 09;
  80.          Regs.BH := 00;
  81.          Regs.AL := lo( SavPtr^[i,j] );
  82.          Regs.BL := hi( SavPtr^[i,j] );
  83.          Regs.CL := 1;
  84.          intr( $10, Regs );
  85.       end;
  86.    window( 1, 1, 80, 25 );
  87. end;
  88.  
  89. procedure ReportBox.Draw;
  90. var
  91.    BoxStr : string[6];
  92.    i : integer;
  93.    MemSize : longint;
  94. begin
  95.    TextColor( FColor );
  96.    TextBackground( BColor );
  97.    BoxStr := #$C9 + #$CD + #$BB +
  98.              #$BA +#$BC + #$C8;
  99.    window( WPosX, WPosY,
  100.            WPosX+WSizeX-1, WPosY+WSizeY-1 );
  101.    ClrScr;
  102.    gotoxy( 1, 1 );           write( BoxStr[1] );
  103.    for i := 1 to WSizeX-2 do write( BoxStr[2] );
  104.                              write( BoxStr[3] );
  105.    gotoxy( 1, WSizeY-1 );    write( BoxStr[6] );
  106.    for i := 1 to WSizeX-2 do write( BoxStr[2] );
  107.                              write( BoxStr[5] );
  108.    gotoxy( 1, 2 );
  109.    InsLine;
  110.    for i := 2 to WSizeY-1 do
  111.    begin
  112.       gotoxy( 1, i );      write( BoxStr[4] );
  113.       gotoxy( WSizeX, i ); write( BoxStr[4] );
  114.    end;
  115.    window( WPosX+1, WPosY+1,
  116.            WPosX+WSizeX-2, WPosY+WSizeY-2 );
  117.    ClrScr;
  118.    MemSize := MemAvail;
  119.    for i := 1 to 30 do
  120.       write('Memory now = ',MemSize,' bytes! ');
  121.    window( 1, 1, 80, 25 );
  122. end;
  123.  
  124. { **** end of methods **** }
  125.  
  126. var
  127.    Box : array[1..5] of BoxPtr;
  128.    MemSize : longint;
  129.    i : integer;
  130.  
  131. procedure Prompt;
  132. begin
  133.    gotoxy( 1, 1 ); clreol;
  134.    write('Memory now = ', MemAvail,
  135.          '. Press ENTER to continue ');
  136.    readln;
  137. end;
  138.  
  139. begin
  140.    ClrScr;
  141.    TextColor( White );
  142.    TextBackground( Black );
  143.    MemSize := MemAvail;
  144.    for i := 1 to 100 do
  145.       write(' Initial memory available = ',
  146.               MemSize, ' bytes! ' );
  147.    gotoxy( 1, 1 ); clreol;
  148.    write('Press ENTER to continue ');
  149.    readln;
  150.    Box[1] := New( BoxPtr, Init(  5, 12, 30, 10,
  151.                   LightRed, Black ) );
  152.    gotoxy( 1, 1 ); clreol;
  153.    write('Memory now = ', MemAvail,
  154.          '. Press ENTER to continue ');
  155.    readln;
  156.    Box[2] := New( BoxPtr, Init( 40,  5, 30, 10,
  157.                   LightGreen, Blue ) );
  158.    gotoxy( 1, 1 ); clreol;
  159.    write('Memory now = ', MemAvail,
  160.          '. Press ENTER to continue ');
  161.    readln;
  162.    Dispose( Box[1], Done );
  163.    Dispose( Box[2], Done );
  164.    gotoxy( 1, 1 ); clreol;
  165.    write( 'Final memory (after release) = ',
  166.            MemAvail, ' bytes...');
  167.    readln;
  168. end.
  169.